COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00004 00003	 IN D WILL BE THE NEW FP
C00009 00004	(entry init subr)
C00011 00005	mroot (0)
C00015 ENDMK
C⊗;

'(THIS IS THE LAP FOR ((DSK (TIM LSP)) BBOF LSP)) 
'(COMPILED BY LISP COMPILER /936 COMAUX /25 PHAS1 /84 MAKLAP /80 INITIA /117) 

;COMPILED ON SEPTEMBER 25, 1984, AT 10:49 AM

(LAP TAK SUBR) 
(ARGS TAK (()  . 3)) 
(PUSH P (% 0 0 FIX1)) 
(PUSH FXP 0 1) 
(PUSH FXP 0 2) 
(PUSH FXP 0 3) 
(MOVE 7 -1 FXP) 
(CAMGE 7 -2 FXP) 
(JRST 0 G0002) 
(MOVE 7 0 FXP) 
(JRST 0 G0001) 
G0002 
(MOVE 7 -2 FXP) 
(SUBI 7 1) 
(PUSH FXP 7) 
(MOVEI 1 0 FXP) 
(NCALL 3 'TAK) 
(MOVE 10 -2 FXP) 
(SUBI 10 1) 
(MOVEI 3 -3 FXP) 
(MOVEI 2 -1 FXP) 
(PUSH FXP 10) 
(MOVEI 1 0 FXP) 
(PUSH FXP 7) 
(NCALL 3 'TAK) 
(MOVE 10 -3 FXP) 
(SUBI 10 1) 
(MOVEI 3 -4 FXP) 
(MOVEI 2 -5 FXP) 
(PUSH FXP 10) 
(MOVEI 1 0 FXP) 
(PUSH FXP 7) 
(NCALL 3 'TAK) 
(PUSH FXP 7) 
(MOVEI 3 0 FXP) 
(MOVEI 2 -1 FXP) 
(MOVEI 1 -3 FXP) 
(NCALL 3 'TAK) 
(SUB FXP (% 0 0 6 6)) 
G0001 
(SUB FXP (% 0 0 3 3)) 
(POPJ P) 
()  

;;; IN D WILL BE THE NEW FP

(DECLARE 
 (SETQ ROOT 4)
 (SETQ ARG3 -8)
 (SETQ ARG2 -7)
 (SETQ ARG1 -6)
 (SETQ RETVAL -5)
 (SETQ RETPC -4)
 (SETQ OLDFP -3)
 (SETQ TEMP2 -2)
 (SETQ TEMP1 -1)
 (SETQ LINK 0))

(LAP BBOF-TAK SUBR)
(ARGS BBOF-TAK (()  . 3)) 
(MOVE #.ROOT MROOT)
(MOVE D #.ROOT)		;NEXT FRAME
(MOVE #.ROOT #.LINK D)	
(MOVE TT 0 A)
(MOVEM TT #.ARG1 D)
(MOVE TT 0 B)
(MOVEM TT #.ARG2 D)
(MOVE TT 0 C)
(MOVEM TT #.ARG3 D)
(MOVEI TT RETURN)
(MOVEM TT #.RETPC D)
(MOVEI TT IFR)
(MOVEM TT #.OLDFP D)
(JRST 0 TAKF)
RETURN
(MOVE TT #.RETVAL D)
(MOVEM #.ROOT MROOT)
(JRST 0 FIX1)

TAKF
(MOVE TT #.ARG2 D)	;ARG2
(CAMGE TT #.ARG1 D)  	;ARG1
(JRST 0 CONT) 
(MOVE TT #.ARG3 D) 
(JRST 0 END) 
CONT

(MOVE R #.ROOT)		;NEXT FP
(MOVE #.ROOT #.LINK R)	;NEW ROOT

(MOVE TT #.ARG1 D)	;SUB1 X
(SUBI TT 1) 
(MOVEM TT #.ARG1 R)	;TRANSFER ARGS
(MOVE TT #.ARG2 D)
(MOVEM TT #.ARG2 R)
(MOVE TT #.ARG3 D)
(MOVEM TT #.ARG3 R)

(MOVEM D #.OLDFP R)	;SAVE OLDFP
(MOVE D R)	 	;NEW FP
(MOVEI T RET1)		;RETURN PC
(MOVEM T  #.RETPC R)
(JRST 0 TAKF) 

RET1
(MOVE TT #.RETVAL D)	;GET RETURN VALUE
(MOVEM TT #.TEMP1 D)	;STASH THAT

(MOVE R #.ROOT)		;NEXT FP
(MOVE #.ROOT #.LINK R)	;NEW ROOT

(MOVE TT #.ARG2 D) 	;SUB1 Y
(SUBI TT 1) 
(MOVEM TT #.ARG1 R)	;TRANSFER ARGS
(MOVE TT #.ARG3 D)
(MOVEM TT #.ARG2 R)
(MOVE TT #.ARG1 D)
(MOVEM TT #.ARG3 R)

(MOVEM D #.OLDFP R)	;SAVE OLDFP
(MOVE D R)	 	;NEW FP
(MOVEI T RET2)		;RETURN PC
(MOVEM T  #.RETPC R)
(JRST 0 TAKF) 

RET2
(MOVE TT #.RETVAL D)	;GET RETURN VALUE
(MOVEM TT #.TEMP2 D)	;STASH THAT

(MOVE R #.ROOT)		;NEXT FP
(MOVE #.ROOT #.LINK R)	;NEW ROOT

(MOVE TT #.ARG3 D) 	;SUB1 Z
(SUBI TT 1) 
(MOVEM TT #.ARG1 R)	;TRANSFER ARGS
(MOVE TT #.ARG1 D)
(MOVEM TT #.ARG2 R)
(MOVE TT #.ARG2 D)
(MOVEM TT #.ARG3 R)

(MOVEM D #.OLDFP R)	;SAVE OLDFP
(MOVE D R)	 	;NEW FP
(MOVEI T RET3)		;RETURN PC
(MOVEM T  #.RETPC R)
(JRST 0 TAKF) 

RET3
(MOVE TT #.RETVAL D)	;GET RETURN VALUE
(MOVEM TT #.ARG3 D)	;STASH THAT
(MOVE TT #.TEMP1 D)
(MOVEM TT #.ARG1 D)
(MOVE TT #.TEMP2 D)
(MOVEM TT #.ARG2 D)

(JRST 0 TAKF)

END

(MOVE R D)		;CURRENT FP IN R
(MOVE D #.OLDFP R)	;RETURN FP IN D
(MOVEM TT #.RETVAL D)	;RETURN VALUE
(MOVE T #.RETPC R)	;READY TO RETURN

(MOVEM #.ROOT #.LINK R)
(MOVE #.ROOT R)
(JRST 0 0 T)		;RETURN

(entry init subr)
(movei tt bbof)
(addi tt #o11)
(movei d 999)
(movem tt mroot)
(move t tt)
loop
(addi tt #o11)
(movem tt 0 t)
(addi t #o11)
(sosle 0 d)
(jrst 0 loop)
(movei a 't)
(popj p)
mroot (0)
bbof (block 9000.)

(0)		;arg3
(0)		;arg2
(0)		;arg1
(0)		;retval
(0)		;retpc
(0)		;oldfp
(0)		;temp2
(0)		;temp1
ifr (0 0 nil)	;link

()